Option Explicit On 

Imports System.Data.OleDb

Public Class SpiderDB

   '''''''''''''''''''''''''''''''''''''
   ' Properties
   '''''''''''''''''''''''''''''''''''''

   ' Read/Write
   Dim Project As String
   Dim Mode As String
   Dim Conn As OleDbConnection
   Public CommandTimeout As Integer = 30
   Public Log As Logger
   Public DBUnicode As Boolean


   '''''''''''''''''''''''''''''''''''''
   ' Defaults
   '''''''''''''''''''''''''''''''''''''

   ' Size of DB Fields
   Const DBFIELDLEN_PROJECT = 20
   Const DBFIELDLEN_URL = 400
   Const DBFIELDLEN_FILENAME = 70
   Const DBFIELDLEN_REFERER = 400
   Const DBFIELDLEN_TITLE = 255
   Const DBFIELDLEN_CTT = 30


   '''''''''''''''''''''''''''''''''''''
   ' Public Methods
   '''''''''''''''''''''''''''''''''''''

   Public Sub New(ByVal Connection As OleDbConnection, ByVal ProjectName As String, ByVal ModeName As String, ByVal DUnicode As Boolean)
      Conn = Connection
      Project = ProjectName
      DBUnicode = DUnicode
      Mode = ModeName
   End Sub



   Sub ClearPageStore()

      Dim SQLString As String
      SQLString = "DELETE FROM [page] WHERE [project]=" & foms(Project)
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub

   Sub ResetPageStore(ByVal CrawlMax As Integer)

      Dim SQLWhere As String
      SQLWhere = "[project]=" & foms(Project)
      If CrawlMax > 0 Then
         ' Update only oldest N urls
         SQLWhere = SQLWhere & " AND [url] In (SELECT TOP " & CrawlMax & " [url] FROM [page] WHERE [project]=" & foms(Project) & " ORDER BY [crawl_date])"
      End If
      Dim SQLString As String
      SQLString = "DELETE FROM [link] WHERE " & SQLWhere
      Log.dpd(SQLString)
      DBExecute(SQLString)
      SQLString = "UPDATE [page] SET [state]=0 WHERE " & SQLWhere
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub

   Sub AddtoCrawl(ByVal URL As String, ByVal Referer As String, ByVal Depth As Integer, ByVal CrawlMax As Integer)

      Dim SQLString As String
      ' Do we already have this URL in the DB?
      If ExistsInDB(Project, URL) Then
         ' Yes - Only update in full refresh mode or if resuming
         'If (Mode = "refresh" And CrawlMax = 0) Or Mode = "resume" Then
         '   SQLString = "UPDATE [page] SET [status]=0, [state]=0 WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
         '   Log.dpd(SQLString)
         '   Try
         '      DBExecute(SQLString)
         '   Catch e As Exception
         '      Log.dpe("SpiderDB/AddToCrawl() Error updating URL " & URL & " with SQL : " & SQLString)
         '      Throw e
         '   End Try
         'End If
      Else
         ' Trap errors to ignore duplicate primary key errors
         SQLString = "INSERT INTO [page] ([project], [url], [referer], [depth], [state]) VALUES (" & fomsulen(Project, DBFIELDLEN_PROJECT) & ", " & fomsulen(URL, DBFIELDLEN_URL) & ", " & fomsulen(Referer, DBFIELDLEN_REFERER) & ", " & fomn(Depth) & ", 0)"
         Log.dpd(SQLString)
         Try
            DBExecute(SQLString)
         Catch e As Exception
            Log.dpe("SpiderDB/AddToCrawl() Error adding URL " & URL & " with SQL : " & SQLString)
            Throw e
         End Try
      End If

   End Sub

   Function ExistsInDB(ByVal Project As String, ByVal URL As String) As Boolean
      Dim SQLString As String = "SELECT TOP 1 [id] FROM [page] WHERE [Project] = " & foms(Project) & " And [URL] = " & foms(URL)
      Dim DA As New OleDbDataAdapter
      Log.dpd(SQLString)
      DA.SelectCommand = New OleDbCommand(SQLString, Conn)
      Dim RS As New System.Data.DataSet
      DA.Fill(RS)
      If RS.Tables(0).Rows.Count > 0 Then
         Return True
      Else
         Return False
      End If
   End Function

   Sub SaveLinkToDB(ByVal URL, ByVal LinkURL)

      ' Trap errors to ignore duplicate primary key errors
      Dim SQLString As String
      SQLString = "INSERT INTO [link] ([project], [url], [link]) VALUES (" & fomsulen(Project, DBFIELDLEN_PROJECT) & ", " & fomsulen(URL, DBFIELDLEN_URL) & ", " & fomsulen(LinkURL, DBFIELDLEN_URL) & ")"
      Log.dpd(SQLString)
      Try
         DBExecute(SQLString)
      Catch e As Exception
         Log.dpe("SpiderDB/SaveLinkToDB() Error adding URL " & URL & " with SQL : " & SQLString)
         Throw e
      End Try

   End Sub

   Sub SaveMetaDataToDB(ByVal URL As String, ByVal Filename As String, ByVal HTMLTitle As String, ByRef TextContent As String, ByVal ContentType As String, ByVal ContentLength As Long, ByVal PageDate As Date)

      If InStr(ContentType, ";") > 0 Then ContentType = Left(ContentType, InStr(ContentType, ";") - 1)

      ' Validation warnings
      If Filename.Length > DBFIELDLEN_FILENAME Then Log.dpw("Filename '" & Filename & "' is too long in SaveMetaDataToDB() and will be truncated.")
      If HTMLTitle.Length > DBFIELDLEN_TITLE Then Log.dpw("Title '" & HTMLTitle & "' is too long in SaveMetaDataToDB() and will be truncated.")
      If ContentType.Length > DBFIELDLEN_CTT Then Log.dpw("ContentType '" & ContentType & "' is too long in SaveMetaDataToDB() and will be truncated.")

      Dim SQLString As String
      SQLString = "UPDATE [page] SET [filename]=" & fomsulen(Filename, DBFIELDLEN_FILENAME) & ", [title]=" & fomsulen(HTMLTitle, DBFIELDLEN_TITLE) & ", [page_date]=" & foms(FormatDateTime(PageDate)) & ", [text_content]=" & fomsu(TextContent) & ", [content_type]=" & fomsulen(ContentType, DBFIELDLEN_CTT) & ", [content_length]=" & fomn(ContentLength) & " WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub

   Sub SaveBinaryResource(ByVal URL As String, ByVal Filename As String, ByVal BinaryContent As System.IO.Stream, ByVal ContentType As String, ByVal ContentLength As Long, ByVal PageDate As Date)

      If InStr(ContentType, ";") > 0 Then ContentType = Left(ContentType, InStr(ContentType, ";") - 1)

      Dim SQLString As String
      SQLString = "UPDATE [page] SET [filename]=?, [text_content]=Null, [binary_content]=?, [content_type]=?, [content_length]=?, [page_date]=? WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
      Log.dpd(SQLString)

      ' Validation warnings
      If Filename.Length > DBFIELDLEN_FILENAME Then Log.dpw("Filename '" & Filename & "' is too long in SaveBinaryResource() and will be truncated.")
      If ContentType.Length > DBFIELDLEN_CTT Then Log.dpw("ContentType '" & ContentType & "' is too long in SaveBinaryResource() and will be truncated.")

      Dim Command As New OleDbCommand(SQLString, Conn)
      With Command
         .Parameters.Add("filename", OleDbType.VarChar)
         .Parameters.Add("binary_content", OleDbType.Binary)
         .Parameters.Add("content_type", OleDbType.VarChar)
         .Parameters.Add("content_length", OleDbType.BigInt)
         .Parameters.Add("page_date", OleDbType.DBDate)
         .Parameters("filename").Value = Left(Filename, DBFIELDLEN_FILENAME)
         .Parameters("binary_content").Value = ReadBinaryStream(BinaryContent, ContentLength)
         .Parameters("content_type").Value = Left(ContentType, DBFIELDLEN_CTT)
         .Parameters("content_length").Value = ContentLength
         .Parameters("page_date").Value = PageDate
      End With

      Try
         Command.ExecuteNonQuery()
      Catch e As Exception
         Log.dpe("SpiderDB/SaveBinaryResource() Error saving binary resource for URL " & URL & " : " & e.Message)
         'Throw e
      End Try

   End Sub

   Sub MarkPageAsAttempted(ByVal URL)

      Dim SQLString
      SQLString = "UPDATE [page] SET [state]=[state]+1 WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub

   Sub MarkPageAsGot(ByVal URL As String, ByVal StatusCode As Integer)

      Dim SQLString
      SQLString = "UPDATE [page] SET [state]=-1, [status]=" & fomn(StatusCode) & ", [crawl_date]=" & foms(FormatDateTimeSec(Now())) & " WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub

   Sub MarkPageStatus(ByVal URL As String, ByVal StatusCode As Integer)

      Dim SQLString
      SQLString = "UPDATE [page] SET [status]=" & fomn(StatusCode) & ", [crawl_date]=" & foms(FormatDateTimeSec(Now())) & " WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub


   Sub MarkPageAsIndexed(ByVal URL As String)

      Dim SQLString
      SQLString = "UPDATE [page] SET [state]=-2 WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub

   Sub MarkPageAsParsed(ByVal URL As String)

      Dim SQLString
      SQLString = "UPDATE [page] SET [state]=-3 WHERE [project]=" & foms(Project) & " AND [url]=" & foms(URL)
      Log.dpd(SQLString)
      DBExecute(SQLString)

   End Sub


   '''''''''''''''''''''''''''''''''''''
   ' Private Methods
   '''''''''''''''''''''''''''''''''''''

   Private Sub DBExecute(ByVal SQLString As String)
      Dim dbCmd As OleDbCommand = New OleDbCommand(SQLString, Conn)
      dbCmd.CommandTimeout = CommandTimeout
      dbCmd.ExecuteNonQuery()
   End Sub

   Public Function fomsu(ByVal str As String) As String

      If IsDBNull(str) Then
         fomsu = "null"
      ElseIf Len(Trim(str)) = 0 Then
         fomsu = "null"
      Else
         If DBUnicode Then
            ' DBUnicode encoding
            fomsu = "N" & foms(str)
         Else
            fomsu = foms(str)
         End If
      End If

   End Function

   Private Function fomsulen(ByVal str As String, ByVal length As Long) As String

      fomsulen = fomsu(Left(str, length))

   End Function

   Private Function fomn(ByVal num As String) As String
      ' Ensure null numbers go as NULL for SQL Statements

      If IsDBNull(num) Then
         fomn = "null"
      ElseIf Len(Trim(num)) = 0 Then
         fomn = "null"
      ElseIf IsNumeric(num) Then
         fomn = num
      Else
         fomn = "null"
      End If

   End Function

   Function foms(ByVal str As String) As String

      If IsDBNull(str) Then
         foms = "null"
      ElseIf Len(Trim(str)) = 0 Then
         foms = "null"
      Else
         ' Add quotes to strings for SQL Statements
         foms = "'" & Replace(CStr(str), "'", "''") & "'"
      End If

   End Function

End Class
